home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio
/
Ham Radio CD-ROM (Emerald Software) (1995).ISO
/
tech
/
bd
/
bd.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-12-28
|
19KB
|
575 lines
Program Bearing_Distance; {BD.pas}
{ This program written by Bob Wagner, N6DUR. Algorithms were utilized
from the ARRL Antenna Handbook. Latitude and Longitude data was provided
by W6SAS, KD4FR, & other sources. To modify for use at your location(QTH),
you will need a Turbo Pascal or compatible compiler, and must change the
items marked with arrows below in the Main Program BD.PAS, and perform
a build (compile all units and main program). As it stands, its good for
San Diego, Calif. Color displays are used; however, it will run momo-
chrome or color. Feel free to change colors to suit your self }
{ Locations with latitude, longitude, and time correction from UTC,
are in Pascal Units GETINFO1, GETINFO2 AND GETINFO3. Locations may
be easily added, modified or deleted. Additions should be made to
Unit GETINFO3 only, since there is a compiler size limitation for
these IF THEN ELSE IF statements of some sort, and you'll get a
compiler error and an erroneous report. }
{ This Turbo Pascal 5.5 Program computes Great Circle bearings and
distances to any place in the world and calculates Local/UTC time
for selected locations stored in the program.
A DX/Station prefix, K1-K0, or Major city may be entered with a
<CR> to generate this information. If a <CR> alone is entered, a
Latitude and Longitude must be provided to generate a Great Circle
bearing and distance to the location; no time information is furnished
in this case. A Minutes to 100th Degree, i.e. , 15 Minutes = .25 Deg,
conversion chart is provided on screen. }
{ Since a DX Prefix like FR can be more than one specific location,
liberty was taken in listing this type of prefix as follows:
"Location is Juan De Nova|Glorioso -11,-48 Reunion -21.1 -55.6",
which indicates the location/time indicated is for Juan De Nova,
but two other locations exist for this DX Prefix, Glorioso island at
11 Degrees South Latitude and 48 Degrees East Longitude, and
Reunion Island at 21.1 Degrees South Latitude and 55.6 East
Longitude. To find the bearing and distance information for these
other locations, the appropriate Latitude/Longitude must be entered.
Another liberty was also taken, i.e., in the case of DX Prefixes
like DA - DP, the Federal Republic of Germany. Only the current
prefixes are available. If the first one is entered, however,
the other prefixes are shown. Of course the user can add any new
prefixes to the program as needed. }
{Bearing_Distance (BD.pas) is the Main Program and must be compiled with
the following Turbo 5.5 Pascal Units available:
SYSDD.PAS -----> Global Data Design
GETINFO1.PAS ---> Procedure Get_DX_Info1 (Prefix Data)
GETINFO2.PAS ---> Procedure Get_DX_Info2 (Prefix Data)
GETINFO3.PAS ---> Procedure Get_Dx_Info3 (City & New Prefix Data)
BDLIB.PAS -----> Function Upper_Case
FINDTIME.PAS --> Procedure Find_Local_Time
SETWIND.PAS ---> Procedure SetWindow }
{$E+} {8087 Emulation. No!, You don't need an 8087 Chip}
{$N+}
Uses CRT,DOS,GetInfo1,GetInfo2,GetInfo3,SysDD,FindTime,BDLib,SetWind;
{ - - - - - - - - - - - - - Declarations - - - - - - - - - - - - - - - - - }
Label
Start,Continue,Skip1,Skip2;
Const
K = 111.11; {ARC TO KILOMETERS}
N = 60; {ARC TO NAUTICAL MI.}
S = 69.041; {ARC TO STATUTE MI.}
A = 32.8167; {SET FOR LATITUDE AT YOUR QTH <----- Change for QTH }
L1 = 117.2083; {SET FOR LONGITUDE AT YOUR QTH <----- Change for QTH }
M = 57.29577951308238; {180/PI - DEGREES TO RADIANS}
PIO2 = 1.57079; {PI/2}
Esc = #27; {Escape Key}
X1 = 9; {Window Size;Small Window}
Y1 = 9;
X2 = 73;
Y2 = 15;
X3 = 2; {Window Size; Large Window}
Y3 = 2;
X4 = 78;
Y4 = 23;
Var
A1, {YOUR LATITUDE IN RADIANS}
B1, {OTHER STATION LATITUDE IN RADIANS}
C, {GREAT CIRCLE BEARING }
RC, {RECIPROCAL GREAT CIRCLE BEARING}
D, {DEGREES OF ARC}
E, {INTERMEDIATE VALUE}
L, {DIFFERENCE IN LONGITUDES/M}
SDistance, {STATUTE MILES}
KDistance, {Kilometers}
NDistance : Double; {Nautical Miles}
Ans : Char;
BString : String[10];
L2String : String[10];
ErrorCode : Integer;
Begin {Main Program}
Repeat { Until ANS = Yes or No }
TextBackground(Blue);
TextColor(Yellow);
ClrScr;
SetWindow(X1,Y1,X2,Y2);
TextColor(LightRed);
Writeln(' * THIS PROGRAM CALCULATES GREAT CIRCLE DISTANCES AND BEARINGS *');
Writeln;
Writeln;
Write(' '); {Space over before reverse video set}
TextBackground(White);
TextColor(Black);
Write('Is Your QTH On DayLight Savings Time? Y/N ');
Ans := ReadKey;
Until Ans In ['Y','y','N','n'];
If Ans IN ['Y','y'] Then
{ Change this to your QTH's Daylight Savings Time correction}
Your_Time_Corr := 7 { <------------ Your DST Correction }
Else
{ Change this to your QTH's Local time correction }
Your_Time_Corr := 8; { <------------ Your Local Time Correction }
Window(1,1,80,25);
Start: {Label}
Repeat
TextBackground(Blue);
TextColor(Yellow);
ClrScr;
SetWindow(X1,Y1,X2,Y2+1);
TextBackGround(Cyan);
TextColor(Black+Blink);
GoToXY(40,8);
Write('< Enter QUIT To Exit >');
TextBackground(Blue);
GoToXY(1,1);
TextColor(LightRed);
Writeln(' * THIS PROGRAM CALCULATES GREAT CIRCLE DISTANCES AND BEARINGS *');
Writeln;
Writeln;
Write(' '); {Space over before inverse video}
TextBackground(White);
TextColor(Black);
Writeln('Enter DX Prefix, K1-K0, Major U.S. City, Or Press <Return>');
TextBackground(Blue);
Write(' '); {Space over before inverse video}
TextBackground(White);
Write('To Enter Lat/Long: ');
Readln(Prefix);
Window(1,1,80,25);
TextBackground(Blue);
TextColor(Yellow);
ClrScr;
Prefix := Upper_Case(Prefix); {Change Prefix to Upper case if necessary}
If Prefix = 'QUIT' Then
Begin
TextBackground(Blue);
TextColor(White);
Exit;
End;
First_Ltr_Prefix := Prefix; {Stores first capital ltr of Prefix}
Writeln;
SetWindow(X3,Y3,X4,Y4); {Produce large yellow framed window}
GoToXY(2,2);
If Prefix = '' Then { If only <Return> Pressed, the BD Program assumes
your entering a position, i.e., Lat/Long Entry}
Begin
{ Put up conversion chart in lower area of display window }
TextBackground(Brown);
TextColor(Black);
GoToXY(15,8);
Writeln('* * * MINUTES TO 100TH DEGREE CONVERSION * * * ');
GoToXY(10,9);
Writeln;
GoToXY(10,10);
Writeln('Min. 0 5 10 15 20 25 30 35 40 45 50 55 60 ');
GoToXY(10,11);
Writeln(' . . . . . . . . . . . . . ');
GoToXY(10,12);
Writeln;
GoToXY(10,13);
Writeln('Deg. 0 8 17 25 33 42 50 58 67 75 83 92 100 ');
GoToXY(10,14);
Writeln(' . . . . . . . . . . . . . ');
Window(2,2,78,10); { Set up small working window for Lat/Long entry,
leaving Min/Deg Conversion Chart alone}
GoToXY(1,2);
TextBackground(Blue);
TextColor(LightRed);
Writeln(' - Enter Negative Values For Southerly Latitudes and Easterly Longitudes -');
Writeln;
Write(' '); {Space over before highlight}
TextBackground(White);
TextColor(Black);
Write('Enter Other Stations Latitude, i.e., 36.25: ');
{ Ensure correct input of Latitude}
{$I-}
Repeat
Readln(Bstring);
Val(Bstring,B,Errorcode);
If (ErrorCode <> 0) OR (B > 90.00) OR ( B < -90.00 ) Then
Begin
Write(Chr(7));
Window(16,5,68,5); {Set window to clear all of last entry}
ClrScr;
Window(2,2,78,10); {Set back to working window}
GoToXY(15,4); { Noted had to be here empirically}
Write('Enter Other Stations Latitude, i.e., 36.25: ');
End;
Until (ErrorCode = 0) AND ( B <= 90.00 ) AND ( B >= -90.00 );
{$I+}
{Ensure Longitude Data Input Correct}
TextBackGround(Blue);
Write(' '); {Space over to highlight}
TextBackground(White);
TextColor(Black);
Write('Enter Other Stations Longitude, i.e., 117.50: ');
{$I-}
Repeat
Readln(L2String);
Val(L2String,L2,ErrorCode);
If (ErrorCode <> 0) OR (L2 > 180.00) OR ( L2 < -180.00 ) Then
Begin
Write(Chr(7));
Window(16,6,68,6);
ClrScr;
Window(2,2,78,10);
GoToXY(15,5);
Write('Enter Other Stations Longitude, i.e., 117.50: ');
End;
Until (ErrorCode = 0) AND (L2 <= 180.00) AND ( L2 >= -180.00 );
{$I+}
TextBackground(Blue);
Window(2,9,78,15); {Clear only the Min/Deg Conversion Chart}
ClrScr;
Window(2,2,79,24); {Reestablish entire screen inside window to write}
GoToXY(1,7); {Goto line 8 to write the Bearing/Distance Data}
TextColor(Yellow);
End {of If Prefix = '' Then}
Else {Beginning of Else portion of above. This is done if user enters
a DX Prefix, Major City, or K1 - K0. Note: K1 - K0 is used when
only a rough indication of possible location is desired. }
Begin
Get_DX_Info1; { Go Look For DX Prefix, Major City, or K1 -K0 }
If Not_Found Then
Begin
Get_DX_Info2;
If Not_Found Then
Begin
Get_Dx_Info3;
If Not_Found Then
Begin
ClrScr;
Write(' ');
TextBackground(White);
TextColor(Black);
Write('Prefix Or City Not Found; Press <Return> To Continue: ');
Readln;
If (First_Ltr_Prefix = 'U') OR (First_Ltr_Prefix = 'R') Then
Begin
TextBackground(Blue);
ClrScr;
TextBackground(White);
TextColor(Black);
GoToXY(19,1);
Write('USSR/Russian Prefix Entered And Not Found:');
GoToXY(12,2);
Writeln;
GoToXY(12,3);
Writeln('1. Try Again With/Without The Numeral');
GOToXY(12,4);
Writeln;
GoToXY(12,5);
Writeln('2. If "R" Prefix Entered, Re-enter Using "U" Prefix.');
GoToXY(25,7);
TextBackGround(Cyan);
TextColor(Black+Blink);
Write('Press <Return> To Continue: ');
Readln;
End;
If (First_Ltr_Prefix = 'D') Then
Begin
TextBackground(Blue);
ClrScr;
TextBackground(White);
TextColor(Black);
GoToXY(19,1);
Write('West German Prefix Entered And Not Found:');
GoToXY(12,2);
Writeln;
GoToXY(30,3);
Writeln('Try Again With "DA"');
GoToXY(25,5);
TextBackGround(Cyan);
TextColor(Black+Blink);
Write('Press <Return> To Continue: ');
Readln;
End;
TextBackground(Blue);
Window(1,1,80,25);
ClrScr;
GoTo Start;
End;
End;
End;
End;
If Prefix <> '' Then {Enter here if a prefix is entered, and if it was
K1 - K0, then jump over any time display work }
Begin
If Prefix = 'K1' Then
GoTo Skip1
Else If Prefix = 'K2' Then
GoTo Skip1
Else If Prefix = 'K3' Then
GoTo Skip1
Else If Prefix = 'K4' Then
GoTo Skip1
Else If Prefix = 'K5' Then
GoTo Skip1
Else If Prefix = 'K6' Then
GoTo Skip1
Else If Prefix = 'K7' Then
GoTo Skip1
Else If Prefix = 'K8' Then
GoTo Skip1
Else If Prefix = 'K9' Then
GoTo Skip1
Else If Prefix = 'K0' Then
GoTo Skip1
Else
Write(' ');
Textbackground(White);
TextColor(Black);
Write('< *Location; Add 1/2 Hour >');
TextBackground(Blue);
Write(' ');
Textbackground(White);
TextColor(Black);
Writeln('< Location On DST; Add 1 Hour >');
TextBackground(Blue);
TextColor(Yellow);
Writeln;
Skip1: {Label}
Writeln(' Location Is ',Country); {Country, US Call Area}
{Location, Or US City }
If Prefix = 'K1' Then {Jump over any time computations}
GoTo Skip2
Else If Prefix = 'K2' Then
GoTo Skip2
Else If Prefix = 'K3' Then
GoTo Skip2
Else If Prefix = 'K4' Then
GoTo Skip2
Else If Prefix = 'K5' Then
GoTo Skip2
Else If Prefix = 'K6' Then
GoTo Skip2
Else If Prefix = 'K7' Then
GoTo Skip2
Else If Prefix = 'K8' Then
GoTo Skip2
Else If Prefix = 'K9' Then
GoTo Skip2
Else If Prefix = 'K0' Then
GoTo Skip2
Else
Find_Local_Time; { Call to get other stations local time }
{ Account for less than 10 hour & 10 Minute situation; add 0 before }
If (OtherHour < 10) AND (YourMinute < 10) Then
Writeln(' Local Time Here Is 0',OtherHour,':0',YourMinute)
Else If (OtherHour <10) AND (YourMinute >= 10) Then
Writeln(' Local Time Here Is 0',OtherHour,':',YourMinute)
Else If (OtherHour >= 10) AND (YourMinute < 10) Then
Writeln(' Local Time Here Is ',OtherHour,':0',YourMinute)
Else { OtherHour >= 10 AND YourMinute >= 10 }
Writeln(' Local Time Here Is ',OtherHour,':',YourMinute);
{ Account for less than 10 hour & 10 Minute situation; add 0 before }
If (UTCHour < 10) AND (YourMinute < 10) Then
Writeln(' UTC Time For The Log Is 0',UTCHour,':0',YourMinute)
Else If (UTCHour <10) AND (YourMinute >= 10) Then
Writeln(' UTC Time For The Log Is 0',UTCHour,':',YourMinute)
Else If (UTCHour >= 10) AND (YourMinute < 10) Then
Writeln(' UTC Time For The Log Is ',UTCHour,':0',YourMinute)
Else { UTCHour >= 10 AND YourMinute >= 10 }
Writeln(' UTC Time For The Log Is ',UTCHour,':',YourMinute);
{Generate Time/Date at QTH}
If (YourHour < 10) AND (YourMinute < 10) Then
Write(' Time And Date At Your QTH Is 0',YourHour,':0',YourMinute)
Else If (YourHour <10) AND (YourMinute >= 10) Then
Write(' Time And Date At Your QTH Is 0',YourHour,':',YourMinute)
Else If (YourHour >= 10) AND (YourMinute < 10) Then
Write(' Time And Date At Your QTH Is ',YourHour,':0',YourMinute)
Else { YourHour >= 10 AND YourMinute >= 10 }
Write(' Time And Date At Your QTH Is ',YourHour,':',YourMinute);
GetDate(MyYear,MyMonth,MyDay,MyDayOfWeek);
Case MyMonth Of
1 : MyMonthStr := 'Jan';
2 : MyMonthStr := 'Feb';
3 : MyMonthStr := 'Mar';
4 : MyMonthStr := 'Apr';
5 : MyMonthStr := 'May';
6 : MyMonthStr := 'Jun';
7 : MyMonthStr := 'Jul';
8 : MyMonthStr := 'Aug';
9 : MyMonthStr := 'Sep';
10: MyMonthStr := 'Oct';
11: MyMonthStr := 'Nov';
12: MyMonthStr := 'Dec';
End; {of case}
Case MyDayOfWeek Of
0 : MyDayOfWeekStr := 'Sun';
1 : MyDayOfWeekStr := 'Mon';
2 : MyDayOfWeekStr := 'Tue';
3 : MyDayOfWeekStr := 'Wed';
4 : MyDayOfWeekStr := 'Thu';
5 : MyDayOfWeekStr := 'Fri';
6 : MyDayOfWeekStr := 'Sat';
End; {of case}
Writeln(' ',MyDayOfWeekStr,' ',MyMonthStr,' ',MyDay,',',MyYear);
End;
Skip2: {Label}
{General computations provided by ARRL ANTENNA HANDBOOK}
A1 := A/M; {Your latitude in radians}
B1 := B/M; {Latitude in radians}
Writeln;
Writeln;
Write(' ');
TextColor(LightRed);
Writeln('G R E A T C I R C L E D A T A ');
TextColor(Yellow);
Writeln(' ========================================================================');
L := (L1-L2)/M; {Difference in Longitude in radians}
E := SIN(A1) * SIN(B1) + COS(A1) * COS(B1) * COS(L);
D := -ArcTan(E/SQRT( 1 - E*E )) + PIO2;
C := ( SIN(B1) - SIN(A1) * E ) / ( COS(A1) * SIN(D) );
If C >= 1 Then
Begin
C := 0;
GoTo Continue;
End;
If C <= -1 Then
Begin
C := 180/M;
GoTo Continue;
End;
C := -ArcTan( C/SQRT(1 - C * C) ) + PIO2;
Continue: {Label}
C := C * M;
If SIN(L) <0 Then
C := 360 - C;
If C + 180 >= 360 Then {Compute Reciprocal Bearing}
RC := (C + 180) - 360
Else
RC := C + 180;
If Prefix <> '' Then
Begin
Write(' ');
TextBackground(White);
TextColor(Black);
Writeln('<DX Prefix Or City: ',Prefix,'>');
TextBackGround(Blue);
TextColor(Yellow);
End;
Writeln;
Writeln(' The Great Circle Bearing From Your QTH: ',C:3:1,' Degrees');
Writeln(' Long Path Or From His QTH: ',RC:3:1,' Degrees');
Writeln;
SDistance := (S * D * M); { Use S for statute miles, N for Nautical, }
KDistance := (K * D * M); { & K for Kilometers }
NDistance := (N * D * M);
Writeln(' The Great Circle Distance is: ',NDistance:6:1,' Nautical Miles');
Writeln(' ',SDistance:6:1,' Statute Miles');
Writeln(' ',KDistance:6:1,' Kilometers');
Writeln;
Write(' ');
TextBackground(Cyan);
TextColor(Black+Blink);
Write('Press <Enter> To Continue Or Esc To Quit: ');
Ans := ReadKey;
Window(1,1,80,25);
Until Ans = Esc;
TextBackground(Blue);
ClrScr;
End. {Main Program}